home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
dbms_mag
/
9102
/
foxpro1.feb
< prev
next >
Wrap
Text File
|
1990-12-19
|
3KB
|
143 lines
************************************************************
* Program ...: FixDBT.prg
* Author ....: P. L. Olympia, Platinum Software Int'l
* Purpose....: Converts a Clipper memo file to FoxPro by
* : (1) Replacing CHR(141) with space
* : (2) Packing the file by removing blank data
* Notes .....: This generic FoxPro program will convert all
* : memo fields in the file. Uses FoxPro
* : low-level file I/O and indirect file ref.
************************************************************
SET TALK OFF
SET SAFE OFF
CLEA ALL
CLOS ALL
PrimName = SPAC(25)
CLEA
TEXT
CONVERT CLIPPER MEMO FILE TO FOXPRO
This program converts all soft returns to spaces in Clipper
memo fields so that FoxPro does not delete them and cause
words from two successive lines to run into each other.
At the prompt below, supply the name of the Clipper .dbt
file to be converted. This file will be renamed with the
extension of .old. You may supply a fully qualified name
including path but do NOT include the .dbt extension
(Example: C:\APERS\PE).
ENDT
@ 20, 0 SAY "Name of .dbt file to convert" GET PrimName
READ
PrimName = ALLTRIM(PrimName)
IF AT(".", PrimName) = 0
new_dbt = PrimName + ".DBT"
ELSE && just in case jokers added the extension anyway
new_dbt = PrimName
PrimName = STUFF(PrimName, AT(".",PrimName), 4, "")
ENDIF
* old_dbt = STUFF(new_dbt, AT(".",new_dbt)+1, 3, "OLD")
old_dbt = PrimName + ".OLD"
bytesize = 2000
bytew = 0
IF FILE(old_dbt)
COPY FILE (new_dbt) TO (old_dbt)
ELSE
RENAME (new_dbt) TO (old_dbt)
ENDIF
CLEA
fh_in = FOPEN(old_dbt)
IF fh_in < 0
? CHR(7), old_dbt, " cannot be opened. Aborting."
RETU
ENDIF
fh_out = FCREATE(new_dbt)
str = FREAD(fh_in, 512) && read & write header
byte = FWRITE(fh_out, str)
DO WHILE !FEOF(fh_in)
str = FREAD(fh_in, bytesize)
oldstr = SUBS(str,1, 512)
str = STRTRAN(str, CHR(141), CHR(32)) && repl soft retn
byte = FWRITE(fh_out, str)
IF byte = 0
? CHR(7), "Error writing to ", new_dbt
ENDIF
bytew = bytew + byte
@ 10, 10 SAY "Bytes written thus far"
@ 10, 40 SAY bytew
ENDDO
***** PART 2 *****
*-- Next, replace all memo field values which are just
*-- whitespace with nulls. Need to cycle thru all memo
*-- fields in the file
CLEA
CLOSE ALL
* Get rid of any existing .fpt file
str = PrimName + ".FPT"
IF FILE(str)
DELE FILE (str)
ENDIF
USE (PrimName) in 1
COPY STRU EXTE TO $temp
SELE 2
USE $temp && in 2
@ 10, 0 SAY "Getting rid of blank memo field data ..."
* Look for all memo fields and replace with nulls
SCAN
IF field_type = "M"
mf = field_name
SELE 1
REPL ALL &mf WITH "" FOR LEN(TRIM(&mf)) = 0
ENDIF
SELE 2
ENDSCAN
USE IN 2
CLEA
@ 10, 0 SAY "File cleanup in progress ..."
* Now we need to copy the file to purge all the nulls
SELE 1
COPY TO $temp
CLOSE ALL
IF .f.
DELE FILE (new_dbt)
new_dbt = PrimName + ".FPT"
COPY FILE $temp.fpt TO (new_dbt)
DELE FILE $temp.dbf
DELE FILE $temp.fpt
ENDIF
str = PrimName + ".DBF"
DELE FILE (str)
RENAME $temp.dbf TO (str)
new_dbt = PrimName + ".FPT"
RENAME $temp.fpt TO (new_dbt)
CLEA
* Ending stuff
CLOSE ALL
SET TALK ON
SET SAFE ON
RETU
*-- eof, FixDbt.Prg